home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / DropBin 1.5 / DropBinUtils.p < prev    next >
Text File  |  1997-04-16  |  4KB  |  202 lines
  1. Unit DropBinUtils;
  2.  
  3. Interface
  4.  
  5. Uses
  6.     Toolbox;
  7.  
  8. Const
  9.     kAppleNum    = 128;
  10.     kFileNum    = 129;
  11.     kAlertID    = 200;
  12.     kMessageID    = 201;
  13.     kReturnkey     =  13;
  14.     kEnterKey    =   3;
  15.     kEscapeKey    =  27;
  16.     kShowRemaining = 0;
  17.     kShowProcessed = 1;
  18.     kShowTotal     =    2;
  19.     
  20. Var
  21.     gBackGround, 
  22.     gHasAppleEvents, 
  23.     gWasEvent:                 boolean;
  24.     gEvent:                 EventRecord;
  25.     gDone:                    boolean; 
  26.     gOApped:                boolean;  { opened application versus dropping document onto app }
  27.     gState:                    boolean;  { determines when it's times to setup progress bar stuff }
  28.     gProcessing:            boolean;  { binhex in progress }
  29.     gFilename:                str255;
  30.     gOutputName:            str255; 
  31.     gStatType:                integer;  
  32.     gRefNum:                 integer;
  33.     gAppleMenu, gFileMenu:     MenuHandle;
  34.     mainCRC:                 unsignedLong;
  35.     dbWindow:                 DialogPtr;
  36.     encodeButton:            ControlHandle;
  37.     quitButton:                ControlHandle;
  38.     cancelButton:            ControlHandle;
  39.  
  40. Procedure DisplayMsg(name: Str255);
  41. Procedure AlertUser(name: Str255; err: integer);
  42. Function AddPtrLong (p: univ Ptr; offset: longint): Ptr;
  43. Procedure OffsetPtr (var p: univ Ptr; offset: longint);
  44. Procedure PtrUpdate(p: Ptr; offset: longint; bytevalue: univ SignedByte);
  45. Function MaxValue(num1, num2: longint): longint;
  46. Function DBFormat(num: longint): str255;
  47. Procedure StringToRect(str: str255; r: rect; size: integer; face: style);
  48. Procedure AppendToRect(str: str255);
  49. Procedure CenterAlert(theID: integer);
  50. Procedure ErrorAlert(stringListID, stringIndexID, errorID: integer);
  51.  
  52. Implementation
  53. {$NR+}
  54.  
  55. Procedure DisplayMsg(name: Str255);
  56.  
  57.     begin
  58.       ParamText(name,'','','');
  59.     Alert(kMessageID,nil);
  60.     end;
  61.  
  62. Procedure AlertUser(name: Str255; err: integer);
  63.  
  64. Var
  65.     str:    str255;
  66.     
  67.     begin
  68.     if err = 0 then
  69.         str := ''
  70.     else
  71.         numToString(err,str);
  72.       ParamText(name,str,'','');
  73.     err := Alert(kAlertID,nil);
  74.     end;
  75.  
  76. Function AddPtrLong (p: univ Ptr; offset: longint): Ptr;
  77.  
  78.     begin
  79.     AddPtrLong := Ptr(ord(p) + offset);
  80.     end;
  81.  
  82. Procedure OffsetPtr (var p: univ Ptr; offset: longint);
  83.  
  84.     begin
  85.     p := Ptr(ord(p) + offset);
  86.     end;
  87.  
  88. Procedure PtrUpdate(p: Ptr; offset: longint; bytevalue: univ SignedByte);
  89.  
  90.     begin
  91.     BlockMoveData(@bytevalue, Ptr(ord4(p) + offset), 1);
  92.     end;
  93.  
  94. Function MaxValue(num1, num2: longint): longint;
  95.  
  96.     begin
  97.     if num1 >= num2 then 
  98.         MaxValue := num1
  99.     else
  100.         MaxValue := num2;
  101.     end;
  102.     
  103. Function DBFormat(num: longint): str255;
  104.  
  105. Var
  106.     r: real;
  107.     suffix: str3;
  108.     str: str255;
  109.     
  110.     begin
  111.     r := num;
  112.     if r > 1024 then
  113.         begin
  114.         r := r / 1024;
  115.         if r > 1024 then
  116.             begin
  117.             r := r / 1024;
  118.             suffix := 'M';
  119.             end
  120.         else
  121.             suffix := 'K';
  122.         NumToString(trunc(r * 10), str);
  123.         str := copy(str,1,length(str) - 1) + '.' + str[length(str)] + suffix;
  124. //        str := StringOf(r:10:1,suffix);
  125.         end
  126.     else
  127.         NumToString(num, str);
  128.     DBFormat := str;
  129.     end; { of DBFormat }
  130.     
  131. Procedure StringToRect(str: str255; r: rect; size: integer; face: style);
  132.  
  133. Var
  134.     theNum:    integer;
  135.     
  136.     begin
  137.     EraseRect(r);
  138.     MoveTo(r.left, r.top + (r.bottom - r.top) div 2);
  139.     GetFNum('Geneva', theNum);
  140.     TextFont(theNum);
  141.     TextSize(size);
  142.     TextFace(face);
  143.     DrawString(str);
  144.     TextFace([]);
  145.     TextFont(0);
  146.     TextSize(0);
  147.     end;
  148.     
  149. Procedure AppendToRect(str: str255);
  150.  
  151. Var 
  152.     theNum:    integer;
  153.     
  154.     begin
  155.     { Assumes that we're already where we're supposed to be }
  156.     GetFNum('Geneva', theNum);
  157.     TextFont(theNum);
  158.     TextSize(9);
  159.     TextFace([]);
  160.     DrawString(str);
  161.     TextFont(0);
  162.     TextSize(0);
  163.     end;
  164.     
  165. Procedure CenterAlert(theID: integer);
  166.  
  167. Var
  168.     theX, theY:        integer;
  169.     theAlertHandle:    AlertTHndl;
  170.     screen, alrt:    rect;
  171.     
  172.     begin
  173.     theAlertHandle := AlertTHndl(GetResource('ALRT',theID));
  174.     if theAlertHandle <> NIL then
  175.         begin
  176.         HLock(Handle(theAlertHandle));
  177.         alrt := theAlertHandle^^.boundsRect;
  178.         screen := qd.screenBits.bounds;
  179.         theX := BSR(((screen.right - screen.left ) - (alrt.right - alrt.left )),1);
  180.         theY := BSR((( screen.bottom - screen.top ) + GetMBarHeight - (alrt.bottom - alrt.top)),1);
  181.         theY := theY - BSR(( screen.bottom - screen.top ),2);    { this moves it up for better viewing! }
  182.         OffsetRect(theAlertHandle^^.boundsRect, theX - alrt.left, theY - alrt.top);
  183.         end;
  184.     SetCursor(qd.arrow);    
  185.     end;
  186.  
  187. Procedure ErrorAlert(stringListID, stringIndexID, errorID: integer);
  188.  
  189. Var
  190.     param,errorStr:        Str255;
  191.     
  192.     begin
  193.     if errorID = noErr then
  194.         exit(ErrorAlert);
  195.     NumToString(errorID, errorStr);
  196.     GetIndString(param, stringListID, stringIndexID);
  197.     ParamText(param,  errorStr, '', '');
  198.     CenterAlert(kAlertID);
  199.     Alert(kAlertID, NIL);
  200.     end;
  201.  
  202. End.